home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / BBS_UTL / DDPLUS71 / DDPLUS.PAS < prev    next >
Pascal/Delphi Source File  |  1995-05-13  |  40KB  |  1,728 lines
  1.  
  2. unit DDPlus;
  3. {$V-,F+}
  4.  
  5. interface
  6. uses dos, crt, comio, ddscott, ddansi2, ddovr, ddovr2;
  7. type
  8.  CharOriginType=(localchar,remotechar);
  9.  strptr=^string;
  10. const
  11.  version= 'Version 7.10  ; 05-01-95';
  12.  
  13.  progname: string[60] = 'Another DDPlus 7.0 Door Game';
  14.  graphics_codes: array[1..5] of string[4] = ('','.ASC','.ANS','.MUS','.ANS');
  15.  { You will have to make up your mind to have item #5 .ANS or .RIP.  You may }
  16.  { find that displaying a ripfile is more effectively done if shown some     }
  17.  { other day.                                                                }
  18.  
  19.  ack=#6;
  20.  nak=#21;
  21.  sot=#1;
  22. var
  23.  lockbaud: longint;                 {lock baud rate                          }
  24.  com1,com2,com3,com4 : byte;        { temporary non-std comports             }
  25.  port1,port2,port3,port4:word;
  26.  irq1,irq2,irq3,irq4 : byte;
  27.  com_port: byte;                    {from DROP FILE: com port                }
  28.  fossilIO,DigiIO: boolean;          {from .CTL file: fossil, digiboard i/o   }
  29.  mintime: byte;                     {Minimum time left before user kicked off}
  30.  notime: string;                    {Out of time filename                    }
  31.  macro,macro_str: string;           {Used in the macro routines              }
  32.  node_num: byte;                    {Node number                             }
  33.  time_credit: integer;              {Time credit +/- (arrow keys)            }
  34.  CharOrigin: CharOrigInType;        {Where character came from               }
  35.  fouled_up: char;                   {Internal use                            }
  36.  localcol: boolean;                 {From .CTL file: Local color enabled     }
  37.  ansion: boolean;                   {Process ANSI locally                    }
  38.  time_check: boolean;               {Check time left - halt if < mintime     }
  39.  moreok : boolean;                  {display <more> prompt?                  }
  40.  curlinenum: integer;               {current line num - used by <more>       }
  41.  stacked: string;                   {used internally - stacked commands      }
  42.  F1toggle: byte;                    {Show Help or Status Line                }
  43.  inchat  : byte;                    {Already inchat don't do this again      }
  44.  chatdone : boolean;                {has there been a chat?                  }
  45.  current_foreground: byte;          {current foreground color                }
  46.  current_background: byte;          {current background color                }
  47.  color_chg: boolean;                {send ANSI color change sequences?       }
  48.  default_fore: byte;                {default foreground color                }
  49.  default_back: byte;                {default background color                }
  50.  cdropped,tdropped: boolean;        {carrier dropped? timedropped            }
  51.  bbs_time_left: integer;            {from DROP FILE: time left               }
  52.  bbs_software: byte;                {from .CTL file: bbs type                }
  53.  baud_rate: longint;                {from DROP FILE: baud rate               }
  54.  statfore,statback: byte;           {status line foreground                  }
  55.  statline: boolean;                 {status line background                  }
  56.  graphics: byte;                    {from DROP FILE: graphics code           }
  57.  local: boolean;                    {from DROP FILE: local mode              }
  58.  user_number: word;           {from DROP FILE: user's access level     }
  59.  user_first_name: string[30];       {from DROP FILE: user's first name       }
  60.  user_last_name: string[30];        {from DROP FILE: user's last name        }
  61.  sysop_first_name: string[30];      {from .CTL file: sysop's first name      }
  62.  sysop_last_name: string[30];       {from .CTL file: sysop's last name       }
  63.  board_name: string[70];            {from .CTL file: board name              }
  64.  Pause_Code : string;               { Rip PAUSE CODE OF YOUR BBS             }
  65.  st_hr, st_mn, st_sc,save_sc: word; {used by timer calculations              }
  66.  color1: boolean;                   {from .CTL file: color1 mode             }
  67.  EMSOK : boolean;                   {/ESM use esm memory                     }
  68.  NetOK : boolean;                   {A Dos only network is present           }
  69.  NoLocal : boolean;                 { Local echo turned off (statback)       }
  70.  stackon: boolean;                  {process stacked commands?               }
  71.  badchar: string;                   {internal use                            }
  72.  maxtime: word;                     {from .CTL file: maximum time in door    }
  73.  user_access_level: word;
  74.  numlines: byte;                    {from .CTL file: number of lines/screen  }
  75.  oldtextmode: word;                 {original text mode                      }
  76.  GoRip      : byte;                 { enables force RIP }
  77.  lastsetfore: byte;                 {last set_foreground color               }
  78.  setforecheck: boolean;             {check repetetive set_foreground calls?  }
  79.  dropfilepath: string;              {from parm list                          }
  80.  cc          : integer;             { read cycle counter                     }
  81.  
  82.  soutput: text;                     {Simultanious output file                }
  83.  
  84.  proc_call_ptr: pointer;            {used internally                         }
  85.  nodirect: boolean;
  86.  
  87. Procedure DV_Aware_On;
  88. Procedure DV_Pause;
  89. Procedure Win_Pause;
  90. Procedure ReleaseTimeSlice;
  91. procedure close_async_port;
  92. procedure Open_async_port;
  93. function  skeypressed: boolean;
  94. Procedure Clear_Region(x,a,b:byte);
  95. procedure sendtext(s: string);
  96. procedure sgoto_xy(x,y: integer);
  97. procedure sclrscr;
  98. procedure sclreol;
  99. procedure swrite(s: string);
  100. procedure swritec(ch: char);
  101. procedure swriteln(s: string);
  102. Procedure swritexy(x,y:integer;s:string);
  103. Procedure Propeller(v:byte);
  104. procedure sread_char(var ch: char);
  105. procedure sread(var s: string);
  106. procedure sread_num(var n: integer);
  107. procedure sread_num_byte(var b: byte);
  108. procedure sread_num_word(var n: word);
  109. procedure sread_num_longint(var n: longint);
  110. Procedure speedread(var ch : char);
  111. function time_left: integer;
  112. procedure set_foreground(f: byte);
  113. procedure set_background(b: byte);
  114. procedure set_color(f,b: byte);
  115. procedure prompt(var s: string; le: integer; pc: boolean);
  116. Procedure elapsed(time1_hour, time1_min, time1_sec, time2_hour, time2_min,
  117.                   time2_sec: longint; var elap_hour, elap_min, elap_sec: word);
  118. procedure get_stacked(var s: string);
  119. procedure sread_char_filtered(var ch: char);
  120. procedure display_status;
  121. Procedure Displayfile(filen: string);
  122. Procedure SelectAnsi(chflag :char;filenm: string);
  123. procedure DDAssignSoutput(var f: text);
  124. procedure InitDoorDriver(ConfigFileName: string);
  125. function Time_used: integer;
  126.  
  127. Implementation
  128. {$L DVAWARE.OBJ}
  129.  
  130. Procedure DV_Aware_On;       External;
  131. Procedure DV_Pause;          External;
  132.  
  133. var
  134.  buffered: boolean;
  135.  exitsave: pointer;
  136.  tcolor,bcolor: integer;
  137.  firsttime: boolean;
  138.  
  139.  
  140. procedure Dos_Sleep;
  141. var
  142.  Regs : Registers;
  143. begin
  144.  with Regs do
  145.    Intr($28,Regs);
  146. end;
  147. { This releases the virtual machine time slice for MSwindows, Dos 5.0, OS/2 }
  148.  
  149. procedure Win_Pause;
  150. var
  151.  Regs : Registers;
  152. begin
  153.  with Regs do
  154.  begin
  155.    Ax := $1680;
  156.    Intr($2F,Regs);
  157.  end;
  158. end;
  159.  
  160. Procedure ReleaseTimeSlice;
  161. begin
  162.   Case Tasker of
  163.     1     : DV_Pause;
  164.     2,4,5 : Win_Pause;
  165.     3     : begin
  166.              Win_Pause;
  167.              Dos_Sleep;        { OS/2 likes this/ it don't hurt }
  168.             end;
  169.   else
  170.     Dos_Sleep;
  171.   end;
  172. end;
  173.  
  174. Procedure Clear_Region(x,a,b:byte);
  175. var
  176.   i : byte;
  177. begin
  178.   for i := a to b do
  179.     begin
  180.       SGoto_XY(x,i);
  181.       Sclreol;
  182.     end;
  183. end;
  184.  
  185. Procedure Chat_Eof(flag:byte);
  186. begin
  187.   If wherey =24 then
  188.     begin
  189.       Clear_Region(1,19,21);
  190.       SGoto_XY(1,19);
  191.       Swrite('»');
  192.     end
  193.   else
  194.   if flag=1 then
  195.     swriteln('');
  196.   If wherey=22 then
  197.     begin
  198.       Clear_Region(1,22,24);
  199.       Sgoto_XY(1,22);
  200.     end;
  201. end;
  202.  
  203. { This is the old continous rolling chat                           }
  204. {
  205. procedure forced_chat;
  206. var
  207.  cx,cy:byte;
  208.  ch: char;
  209.  a: integer;
  210.  old_origin: charorigintype;
  211.  word: string;
  212.  lastspace: integer;
  213. begin;
  214.  swriteln('');
  215.  set_foreground(lightred);
  216.  swriteln('Chat mode enabled. ESC exits.');
  217.  set_foreground(lightblue);
  218.  old_origin:=localchar;
  219.  lastspace:=0;
  220.  word:='';
  221.  repeat;
  222.   sread_char(ch);
  223.   if charorigin<>old_origin then if charorigin=localchar then set_foreground(lightblue) else set_foreground(yellow);
  224.   old_origin:=charorigin;
  225.   swrite(ch);
  226.   if ch=#8 then begin;
  227.    swrite(' '+#8);
  228.    if length(word)>0 then delete(word,1,1);
  229.   end;
  230.   if ch=#13 then begin;
  231.    swrite(#10);
  232.    lastspace:=0;
  233.    word:='';
  234.   end;
  235.   if (ch<>' ') and (ch<>#8) and (ch<>#13) then word:=word+ch;
  236.   if ch=' ' then begin;
  237.    lastspace:=wherex;
  238.    word:='';
  239.   end;
  240.   if wherex>75 then begin;
  241.    if lastspace=0 then begin;
  242.     swriteln('');
  243.    end else begin;
  244.     while wherex>lastspace do swrite(#8+' '+#8);
  245.     swriteln('');
  246.     swrite(word);
  247.    end;
  248.   end;
  249.  until ch=#27;
  250.  set_foreground(default_fore);
  251. end;
  252. }
  253. { This is the new formated chat that uses lines 19-24 for a chat   }
  254. { window that rolls from 19-24 and back again.                     }
  255.  
  256. { Remember to check for #3 when this returns so you can refresh the }
  257. { area this has colored black.                                      }
  258. procedure forced_chat;
  259. var
  260.   i,x,y,cx,cy,oldy:byte;
  261.   ch: char;
  262.   a: integer;
  263.   old_origin: charorigintype;
  264.   word: string;
  265.   lastspace: integer;
  266.  
  267. begin;
  268.   SGoto_XY(1,19);
  269.   Set_Color(0,6);
  270.   swrite(' The SYSOP wants to chat with you.       [ESC] to exit.');
  271.   Sclreol;
  272.   Set_Color(7,0);
  273.   Clear_Region(1,20,24);
  274.   SGoto_XY(1,20);
  275.   Swrite('»');
  276.   set_foreground(11);
  277.   old_origin:=localchar;
  278.   lastspace:=0;
  279.   word:='';
  280.  
  281.   repeat;
  282.   sread_char(ch);
  283.   if charorigin<>old_origin then
  284.     if charorigin=localchar then
  285.       set_foreground(11)
  286.     else
  287.       set_foreground(14);
  288.   old_origin:=charorigin;
  289.   swrite(ch);
  290.   if ch=#8 then
  291.     begin
  292.       swrite(' '+#8);
  293.       if length(word)>0 then
  294.         delete(word,1,1);
  295.     end;
  296.  
  297.   if ch=#13 then
  298.    begin
  299.      if wherey >23 then
  300.        Chat_Eof(0)
  301.      else
  302.       begin
  303.        swrite(#10);
  304.         if wherey =22 then
  305.           Chat_Eof(0);
  306.        swrite('»');
  307.       end;
  308.      lastspace:=0;
  309.      word:='';
  310.    end;
  311.  
  312.   if (ch<>' ') and (ch<>#8) and (ch<>#13) then
  313.     word:=word+ch;
  314.   if ch=' ' then
  315.     begin
  316.      lastspace:=wherex;
  317.      word:='';
  318.     end;
  319.  
  320.   if wherex>75 then
  321.     begin
  322.      if lastspace=0 then
  323.         Chat_Eof(1)
  324.      else
  325.        begin
  326.          while wherex>lastspace do swrite(#8+' '+#8);
  327.          Chat_Eof(1);
  328.          swrite(word);
  329.        end;
  330.     end;
  331.   until ch=#27;
  332.   Set_Color(7,0);
  333.   Clear_Region(1,19,24);
  334. end;
  335.  
  336. Procedure DropMessage;
  337. begin;
  338.    writeln;
  339.    writeln('Carrier Dropped, returning to BBS.');
  340.    cdropped:=true;
  341.    halt;
  342. end;
  343.  
  344. procedure BlankScreenMessage;
  345. begin
  346.   gotoxy (trunc((80-length(progname))/2),10);
  347.   write(progname);
  348.   gotoxy (26,12);
  349.   write('Local screen mode turned off.');
  350.   gotoxy (1,1);
  351. end;
  352.  
  353. Procedure HosedMessage;
  354. begin
  355.   Swriteln('');
  356.   Swriteln('');
  357.   Set_Color(15,0);
  358.   Swrite('The SYSOP has terminated the game and is returning you to the BBS!');
  359.   ReleaseTimeSlice;
  360.   delay(500);
  361.   ReleaseTimeSlice;
  362. end;
  363.  
  364. procedure textcolor(i: byte);
  365. begin;
  366.  if localcol then crt.textcolor(i);
  367.  tcolor:=i;
  368. end;
  369.  
  370. procedure textbackground(i: byte);
  371. begin;
  372.  if localcol then crt.textbackground(i);
  373.  bcolor:=i;
  374. end;
  375.  
  376. procedure elapsed(time1_hour, time1_min, time1_sec, time2_hour, time2_min,
  377.                   time2_sec: longint; var elap_hour, elap_min, elap_sec: word);
  378. var
  379.  a,b,c: longint;
  380. begin;
  381.  if time1_hour<time2_hour then time1_hour:=time1_hour+24;
  382.  a:=(time1_hour*3600)+(time1_min*60)+time1_sec;
  383.  b:=(time2_hour*3600)+(time2_min*60)+time2_sec;
  384.  c:=a-b;
  385.  if c>=3600 then elap_hour:=c div 3600 else elap_hour:=0;
  386.  c:=c-((c div 3600)*3600);
  387.  if c>=60 then elap_min:=c div 60 else elap_min:=0;
  388.  c:=c-((c div 60)*60);
  389.  elap_sec:=c;
  390. end;
  391.  
  392. function time_left: integer;
  393. var
  394.  hour, minute, second, sec100: word;
  395.  el_hr, el_mn, el_sc: word;
  396. begin;
  397.  gettime(hour, minute, second, sec100);
  398.  elapsed(hour, minute, second, st_hr, st_mn, st_sc, el_hr, el_mn, el_sc);
  399.  time_left:=time_credit+(bbs_time_left-((el_hr*60)+el_mn));
  400. end;
  401.  
  402. function time_used: integer;
  403. var
  404.  hour, minute, second, sec100: word;
  405.  el_hr, el_mn, el_sc: word;
  406. begin;
  407.  gettime(hour, minute, second, sec100);
  408.  elapsed(hour, minute, second, st_hr, st_mn, st_sc, el_hr, el_mn, el_sc);
  409.  time_used:=(el_hr*60)+el_mn;
  410. end;
  411.  
  412. procedure display_Fkeys;
  413. var
  414.  a,b: integer;
  415.  x,y: integer;
  416. begin;
  417.  save_sc:=999;
  418.  x:=wherex;
  419.  y:=wherey;
  420.  cursoroff;
  421.  window(1,1,80,numlines);
  422.  a:=tcolor;
  423.  b:=bcolor;
  424.  textcolor(statfore);
  425.  textbackground(statback);
  426.  gotoxy(1,numlines);
  427.  clreol;
  428.  write(' F1=Help Toggle │ F2=Chat │ F7=+5Min │ F8=-5Min │ F10=Eject │');
  429.  window(1,1,80,numlines-1);
  430.  gotoxy(x,y);
  431.  textcolor(a);
  432.  textbackground(b);
  433.  If Not NoLocal then cursoron;
  434.  if f1toggle=0 then
  435.   f1toggle:=1
  436.  else
  437.   begin
  438.     firsttime:=true;
  439.     f1toggle:=0
  440.   end;
  441. end;
  442.  
  443. procedure display_status;
  444. var
  445.  a,b: integer;
  446.  c,d: word;
  447.  x,y: integer;
  448.  hour, minute, second, sec100, el_mn, el_hr, el_sc: word;
  449. begin;
  450.  x:=wherex;
  451.  y:=wherey;
  452.  cursoroff;
  453.  window(1,1,80,numlines);
  454.  a:=tcolor;
  455.  b:=bcolor;
  456.  textcolor(statfore);
  457.  textbackground(statback);
  458.  
  459.  if firsttime then
  460.    begin
  461.      gotoxy(1,numlines);
  462.      clreol;
  463.      write(user_first_name+' '+user_last_name);
  464.      gotoxy(40-(length(progname+' - Node '+va(node_num)) div 2),numlines);
  465.      write(progname+' - Node '+va(node_num));
  466.      firsttime:=false;
  467.      save_sc:=999;
  468.    end;
  469.  gettime(hour,minute,second,sec100);
  470.  elapsed(hour,minute,second,st_hr,st_mn,st_sc,el_hr,el_mn,el_sc);
  471.  c:=(bbs_time_left-1)+time_credit;
  472.  if (time_left<mintime) and (time_check) then
  473.    begin
  474.      cursoron;
  475.      if notime<>'' then swriteln('(*** Time limit exceeded ***)');
  476.      swriteln('');
  477.      tdropped:=true;
  478.      halt;
  479.    end;
  480.  c:=c-((el_hr*60)+el_mn);
  481.  d:=60-el_sc;
  482.  if d<>save_sc then
  483.    begin
  484.      gotoxy(74,numlines);
  485.      clreol;
  486.      gotoxy(74,numlines);
  487.      write(c,':');
  488.      if d<10 then write('0');
  489.      write(d);
  490.      save_sc:=d;
  491.    end;
  492.  
  493.  textcolor(a);
  494.  textbackground(b);
  495.  window(1,1,80,numlines-1);
  496.  gotoxy(x,y);
  497.  If Not NoLocal then cursoron;
  498. end;
  499.  
  500. procedure Selectansi;
  501. var
  502.   f: text;
  503.   b,g,counter,chcount : integer;
  504.   c,quit: boolean;
  505.   k,ch: char;
  506.   ansisave,moresave,swon : boolean;
  507.   ofm: word;
  508. begin
  509.   ofm:=filemode;
  510.   filemode:=66;
  511.   ansisave:=ansion;
  512.   ansion:=true;
  513.   quit:=false;
  514.   counter:=1;
  515.   chcount:=0;
  516.   c:=false;
  517.   swon:=false;
  518.   g:=graphics;
  519.   k:=' ';
  520.  
  521.   assign(f,'ERROR');
  522.   if pos('.',filenm)<>0 then assign(f,filenm) else
  523.    begin
  524.      while (g>=0) and (not c) do
  525.        begin
  526.          if exist(filenm+graphics_codes[g]) then
  527.            begin
  528.              assign(f,filenm+graphics_codes[g]);
  529.              c:=true;
  530.            end;
  531.          dec(g);
  532.        end;
  533.    end;
  534.  
  535.  {$I-}
  536.  filemode:=66;
  537.  reset(f);
  538.  filemode:=66;
  539.  {$I+}
  540.  if ioresult<>0 then
  541.    begin
  542.      swriteln('File '+filenm+' missing');
  543.      ansion:=ansisave;
  544.      filemode:=ofm;
  545.      exit;
  546.    end;
  547.  
  548.  while (not eof(f)) and (not quit) do
  549.   begin
  550.     if ch=#10 then
  551.       begin
  552.         chcount:=0;
  553.         inc(counter);
  554.       end;
  555.  
  556.     read(f,ch);
  557.     if chcount>0 then
  558.       begin
  559.         if swon then
  560.            swritec(ch);
  561.       end
  562.     else
  563.       begin
  564.         if swon then
  565.           begin
  566.             if ch<>chflag then
  567.               quit:=true;
  568.           end
  569.         else
  570.         if ch=chflag then
  571.           swon:=true;
  572.       end;
  573.     inc(chcount);
  574.    end;
  575.  
  576.    close(f);
  577.    ansion:=ansisave;
  578.    set_foreground(default_fore);
  579.    filemode:=ofm;
  580. end;
  581.  
  582. procedure displayfile;
  583. var
  584.   f: text;
  585.   g, counter,b: integer;
  586.   c,quit,nonstop: boolean;
  587.   k,ch: char;
  588.   ansisave,moresave: boolean;
  589.   ofm: word;
  590. begin
  591.   ofm:=filemode;
  592.   filemode:=66;
  593.   ansisave:=ansion;
  594.   ansion:=true;
  595.   nonstop:=false;
  596.   quit:=false;
  597.   counter:=1;
  598.   c:=false;
  599.   g:=graphics;
  600.   k:=' ';
  601.   assign(f,'ERROR');
  602.   if pos('.',filen)<>0 then assign(f,filen) else
  603.    begin
  604.      while (g>=0) and (not c) do
  605.        begin
  606.          if exist(filen+graphics_codes[g]) then
  607.            begin
  608.              if g in [2,3,5] then
  609.                nonstop:=true;
  610.              assign(f,filen+graphics_codes[g]);
  611.              c:=true;
  612.            end;
  613.          dec(g);
  614.        end;
  615.    end;
  616.  {$I-}
  617.  filemode:=66;
  618.  reset(f);
  619.  filemode:=66;
  620.  {$I+}
  621.  if ioresult<>0 then
  622.    begin
  623.      swriteln('File '+filen+' missing - please inform sysop');
  624.      ansion:=ansisave;
  625.      filemode:=ofm;
  626.      exit;
  627.    end;
  628.  while (not eof(f)) and (not quit) do
  629.   begin
  630.     if ch=#10 then inc(counter);
  631.  {  if (counter=24) and (not nonstop) then
  632.       begin
  633.         counter:=1;
  634.         swrite('Continue,Stop,Non-stop ? ');
  635.         sread_char(ch);
  636.         for b:=1 to 26 do
  637.           swrite(chr(8));
  638.         clreol;
  639.        if ch in ['S','s'] then
  640.          Quit:=true;
  641.        if ch in ['N','n'] then
  642.          nonstop:=true;
  643.       end; }
  644.     { remove the comments to implement the pause function }
  645.  
  646.     read(f,ch);
  647.     if skeypressed then
  648.       sread_char(k);
  649.     if k=^S then
  650.       sread_char(k);
  651.     if (k=^k) or (k=^c) then
  652.       begin
  653.         close(f);
  654.         AsyncPurgeOutput;
  655.         swriteln('');
  656.         ansion:=ansisave;
  657.         filemode:=ofm;
  658.         exit;
  659.       end;
  660.     if not quit then
  661.       swritec(ch);
  662.    end;
  663.  
  664.    close(f);
  665.    ansion:=ansisave;
  666.    set_foreground(default_fore);
  667.    filemode:=ofm;
  668. end;
  669.  
  670. procedure SendText(s: string);
  671. var
  672.  a: integer;
  673. begin;
  674.  If (Not AsyncCarrierPresent) then DropMessage;
  675.  for a:=1 to length(s) do AsyncSendChar(s[a]);
  676. end;
  677.  
  678. procedure CharOut(ch: char);
  679. begin;
  680.  AsyncSendChar(ch);
  681. end;
  682.  
  683. function charin(var ch: char): boolean;
  684. begin;
  685.  if badchar<>'' then
  686.    begin;
  687.      ch:=badchar[1];
  688.      delete(badchar,1,1);
  689.      charin:=true;
  690.    end
  691.  else
  692.   if AsyncCharPresent then
  693.      begin;
  694.        AsyncReceiveChar(ch);
  695.        charin:=true;
  696.      end
  697.  else charin:=false;
  698. end;
  699.  
  700. procedure CloseDown;
  701. begin;
  702.   if buffered then
  703.      AsyncFlushOutput;
  704.   If Not noFossinit then
  705.      AsyncCloseCom(com_port);
  706.   buffered := false;
  707. end;
  708.  
  709. procedure sclrscr;
  710. begin
  711.  if not local then sendtext(#27'[2J');
  712.  If NoLocal then
  713.    begin
  714.      TextColor(statfore);
  715.      TextBackGround(statback);
  716.    end;
  717.  
  718.  clrscr;
  719.  If NoLocal then BlankScreenMessage;
  720.  curlinenum:=1;
  721.  lastsetfore:=99;
  722. end;
  723.  
  724. procedure sclreol;
  725. begin;
  726.  if not local then sendtext(#27'[K');
  727.  clreol;
  728. end;
  729.  
  730. procedure morecheck;
  731. var
  732.  ch: char;
  733. begin;
  734.  swrite('<More>');
  735.  sread_char(ch);
  736.  swrite(#8+#8+#8+#8+#8+#8);
  737.  write('      ');
  738.  write(#8+#8+#8+#8+#8+#8);
  739. end;
  740.  
  741. procedure swritec(ch: char);
  742. begin;
  743.  if not local then
  744.    AsyncSendChar(ch);
  745.  if NoLocal then
  746.     begin
  747.       gotoxy(Wherex+1,Wherey);
  748.       exit;
  749.     end;
  750.  if ansion then
  751.     ansi_write(ch)
  752.   else
  753.     write(ch);
  754. end;
  755.  
  756. procedure swrite(s: string);
  757. begin;
  758.  if hexon then hexfilt(s);
  759.  if not local then sendtext(s);
  760.  if NoLocal then
  761.   begin
  762.     GotoXY(wherex+length(s),wherey);
  763.     exit;
  764.   end;
  765.  
  766.  if ansion then
  767.      ansi_write_str(s)
  768.  else
  769.     write(s);
  770. end;
  771.  
  772. procedure swriteln(s: string);
  773. begin;
  774.  if hexon then hexfilt(s);
  775.  if not local then sendtext(s+#13+#10);
  776.  if NoLocal then
  777.   begin
  778.     GotoXY(wherex+length(s),wherey);
  779.     writeln;
  780.     exit;
  781.   end;
  782.  
  783.  if ansion then
  784.    begin
  785.      s:=s+#13+#10;
  786.      ansi_write_str(s);
  787.    end
  788.  else
  789.    writeln(s);
  790.  inc(curlinenum);
  791.  if (curlinenum=(numlines-1)) then begin;
  792.   curlinenum:=1;
  793.   if moreok then morecheck;
  794.  end;
  795. end;
  796.  
  797. Procedure swritexy;
  798. begin
  799.  Sgoto_XY(x,y);
  800.  if hexon then hexfilt(s);
  801.  if not local then sendtext(s);
  802.  if NoLocal then
  803.   begin
  804.     GotoXY(wherex+length(s),wherey);
  805.     exit;
  806.   end;
  807.  
  808.  if ansion then
  809.      ansi_write_str(s)
  810.  else
  811.     write(s);
  812. end;
  813.  
  814. Procedure Propeller(v:byte);
  815. const
  816.   CX :array [1..6] of char =(chr(250),'│','/','-','\','?');
  817. var
  818.   b : byte;
  819. begin
  820.   b:=6;
  821.   case v of
  822.    1,15      : b:=1;
  823.    2,6,10,14 : b:=2;
  824.    3,7,11    : b:=3;
  825.    4,8,12    : b:=4;
  826.    5,9,13    : b:=5;
  827.   end;
  828.   if v < 17 then
  829.     begin
  830.       Swritec(cx[b]);
  831.       SwriteC(#8);
  832.     end;
  833. end;
  834.  
  835. procedure DDexit;
  836. begin;
  837.  If not local then CloseDown;
  838.  if lastmode<>oldtextmode then textmode(oldtextmode);
  839.  cursoron;
  840.  { This should fix the problem OS/2 serial IO drivers are having exiting. }
  841.  exitproc:=exitsave;
  842. end;
  843.  
  844.  { Customize this for each game }
  845.  
  846. Procedure CallProc;
  847. inline($FF/$1E/Proc_Call_Ptr);
  848.  
  849. Procedure DefineFKeys(var a:char;fkeyon:byte);
  850. begin
  851.   a:=#0;
  852.   case fkeyon of
  853.     1: Display_Fkeys;
  854.     2: begin
  855.          if inchat>0 then exit;
  856.          inchat:=1;
  857.          Forced_Chat;
  858.          inchat:=0;
  859.          a:=#3;
  860.          chatdone:=true;
  861.        end;
  862.     7: inc(time_credit,5);
  863.     8: dec(time_credit,5);
  864.    10: begin
  865.          HosedMessage;
  866.          Halt;
  867.        end;
  868.   end;
  869. end;
  870.  
  871. procedure sfkeys(var a: char);
  872. var
  873.  fkeyon:byte;
  874. begin
  875.   fkeyon:=0;
  876.    case a of
  877.      #59:fkeyon:=1;
  878.      #60:fkeyon:=2;
  879.      #61:fkeyon:=3;
  880.      #62:fkeyon:=4;
  881.      #63:fkeyon:=5;
  882.      #64:fkeyon:=6;
  883.      #65:fkeyon:=7;
  884.      #66:fkeyon:=8;
  885.      #67:fkeyon:=9;
  886.      #68:fkeyon:=10;
  887.   else
  888.      a:=#0;
  889.   end;
  890.   If a<>#0 then
  891.     DefineFkeys(a,fkeyon);
  892. end;
  893.  
  894. Procedure ReadScanCode(var a:char);
  895. begin
  896.   a :=readkey;
  897.   if (a=#0) and (keypressed) then
  898.     begin;
  899.       a:=readkey;
  900.       sFkeys(a);
  901.     end;
  902. end;
  903.  
  904. procedure sread_ch(var ch: char);
  905. var
  906.  a: char;
  907.  i : integer;
  908. begin;
  909.  cc:=0;
  910.  a:=#0;
  911.  ch:=#0;
  912.  charorigin:=localchar;
  913.  
  914.  repeat;
  915.   if not local then
  916.     begin
  917.       If (Not AsyncCarrierPresent) then DropMessage;
  918.       if charin(a) then charorigin:=remotechar;
  919.     end;
  920.   if keypressed then
  921.     ReadScanCode(a);
  922.  
  923.   If (a<>#0) then
  924.     ch := a
  925.   else
  926.   If cc mod 100 = 99 then
  927.     ReleaseTimeSlice;
  928.  
  929.   inc(cc);
  930.   if statline then
  931.     begin;
  932.        if cc=1 then display_status;
  933.        if cc>1000 then cc:=0;
  934.     end;
  935.   until ch<>#0;
  936. end;
  937.  
  938. procedure sread_char(var ch: char);
  939. var
  940.  ch1,ch2: char;
  941. begin;
  942.  curlinenum:=1;
  943.  repeat;
  944.   if macro<>'' then
  945.     begin;
  946.       ch:=macro[1];
  947.       delete(macro,1,1);
  948.     end
  949.   else
  950.     repeat;
  951.     ch:=#0;
  952.     if fouled_up<>#0 then
  953.       begin;
  954.         ch:=fouled_up;
  955.         fouled_up:=#0;
  956.       end
  957.     else
  958.       begin;
  959.         sread_ch(ch1);
  960.         if ch1=^N then
  961.           begin;
  962.             ch1:=#1;
  963.             macro:=macro_str;
  964.           end;
  965.  
  966. {       delay(20);
  967.         if (ch1=#27) and skeypressed then
  968.           begin;
  969.             sread_ch(ch2);
  970.             if ch2='[' then
  971.               begin;
  972.                 sread_ch(ch2);
  973.                 if (ch2 in ['1'..'9']) and (skeypressed) then
  974.                   sread_ch(ch2);
  975.                 case ch2 of
  976.                    'A' : ch:=^E;
  977.                    'B' : ch:=^X;
  978.                    'C' : ch:=^D;
  979.                    'D' : ch:=^S;
  980.                 end;
  981.               end
  982.             else
  983.               begin;
  984.                 ch:=ch1;
  985.                 fouled_up:=ch2;
  986.               end;
  987.            end
  988.          else
  989.   }
  990.            ch:=ch1;
  991.         end;
  992.   until ch<>#0;
  993.  until ch<>#1;
  994. end;
  995.  
  996. procedure sread_char_filtered(var ch: char);
  997. begin;
  998.  sread_char(ch);
  999.  if ch in [#1..#7,#10..#12,#14..#31,#127..#255] then ch:='.';
  1000. end;
  1001.  
  1002. procedure get_stacked(var s: string);
  1003. var
  1004.  s2: string;
  1005.  a: integer;
  1006.  b: boolean;
  1007. begin;
  1008.  s:='';
  1009.  s2:='';
  1010.  b:=false;
  1011.  if length(stacked)=0 then begin;
  1012.   s:='';
  1013.   exit;
  1014.  end;
  1015.  for a:=1 to length(stacked) do begin;
  1016.   if stacked[a]=';' then b:=true else if not b then s:=s+stacked[a];
  1017.   if b then s2:=s2+stacked[a];
  1018.  end;
  1019.  if length(s2)>=1 then delete(s2,1,1);
  1020.  stacked:=s2;
  1021. end;
  1022.  
  1023. procedure sread(var s: string);
  1024. var
  1025.  ch: char;
  1026.  hexsave: boolean;
  1027. begin;
  1028.  hexsave:=hexon;
  1029.  hexon:=false;
  1030.  curlinenum:=1;
  1031.  s:='';
  1032.  get_stacked(s);
  1033.  if s<>'' then swrite(s) else begin;
  1034.   repeat;
  1035.    sread_char_filtered(ch);
  1036.    if (ch<>#8) and (ch<>^M) then begin;
  1037.     s:=s+ch;
  1038.     swrite(ch);
  1039.    end;
  1040.    if (ch=chr(8)) and (length(s)>0) then begin;
  1041.     delete(s,length(s),1);
  1042.     swrite(chr(8)+' '+chr(8));
  1043.    end;
  1044.   until (ch=^M);
  1045.   if (pos(';',s)<>0) and (stackon) then begin;
  1046.    stacked:=s;
  1047.    get_stacked(s);
  1048.   end;
  1049.  end;
  1050.  swriteln('');
  1051.  hexon:=hexsave;
  1052.  if hexon then hextodec(s);
  1053. end;
  1054.  
  1055. procedure sread_num(var n: integer);
  1056. var
  1057.  e: integer;
  1058.  s: string;
  1059. begin;
  1060.  sread(s);
  1061.  val(s,n,e);
  1062. end;
  1063.  
  1064. procedure sread_num_byte(var b: byte);
  1065. var
  1066.  e: integer;
  1067.  s: string;
  1068. begin;
  1069.  sread(s);
  1070.  val(s,b,e);
  1071. end;
  1072.  
  1073. procedure sread_num_word(var n: word);
  1074. var
  1075.  e: integer;
  1076.  s: string;
  1077. begin;
  1078.  sread(s);
  1079.  val(s,n,e);
  1080. end;
  1081.  
  1082. procedure sread_num_longint(var n: longint);
  1083. var
  1084.  e: integer;
  1085.  s: string;
  1086. begin;
  1087.  sread(s);
  1088.  val(s,n,e);
  1089. end;
  1090.  
  1091.  { Speed read is a one time read of the comport.  What I have used it for }
  1092.  { is part of another routine that reads for a number of seconds.  Here   }
  1093.  { the caller must enter all his commands or info in that time allotment. }
  1094.  { They cannot delay a multi-node game by not inputting a command.        }
  1095.  
  1096.  
  1097. Procedure SpeedRead(var ch : char);
  1098. var
  1099.   a : char;
  1100. begin
  1101.   inc(cc);
  1102.   if statline then
  1103.     begin;
  1104.        if cc=1 then display_status;
  1105.        if cc>1000 then cc:=0;
  1106.     end;
  1107.  
  1108.   ch := #0;
  1109.   a := #0;
  1110.   If local then
  1111.     begin
  1112.       If KeyPressed then
  1113.         ReadScanCode(a);
  1114.       If (a<>#0) then
  1115.         ch := a
  1116.       else
  1117.       If cc mod 100 = 99 then
  1118.          ReleaseTimeSlice;
  1119.       exit;
  1120.     end;
  1121.  
  1122.   charorigin:=localchar;
  1123.   If (Not AsyncCarrierPresent) then DropMessage;
  1124.  
  1125.   if charin(a) then
  1126.     charorigin:=remotechar
  1127.   else
  1128.   If KeyPressed then
  1129.      ReadScanCode(a);
  1130.  
  1131.   If (a<>#0) then
  1132.     ch := a
  1133.   else
  1134.   If cc mod 100 = 99 then
  1135.     ReleaseTimeSlice;
  1136. end;
  1137.  
  1138. function va(i: integer): string;
  1139. var
  1140.  s: string;
  1141. begin;
  1142.  str(i,s);
  1143.  va:=s;
  1144. end;
  1145.  
  1146. procedure set_foreground;  { f : byte }
  1147. const
  1148.   colorf: array[0..7] of integer = (30,34,32,36,31,35,33,37);
  1149.   colorb: array[0..7] of integer = (40,44,42,46,41,45,43,47);
  1150. var
  1151.  s,sb : string;
  1152. begin;
  1153.  if f > 31 then exit;
  1154.  if (f = current_foreground) then exit;
  1155.  if Not NoLocal then textcolor(f);
  1156.  
  1157.  if not local then
  1158.    begin
  1159.    if (f=7) and (current_background=0) then
  1160.        sendtext(#27+'[0m')
  1161.    else
  1162.    begin
  1163.    If current_background = 0 then
  1164.      sb := ''
  1165.    else
  1166.      sb := ';'+va(colorb[current_background]);
  1167.    case f of
  1168.      0..7  :  begin
  1169.                 s := va(colorf[f]);
  1170.                 case current_foreground of
  1171.                 { 0..7  : s := s;  }
  1172.                   8..31 : s := '0;'+s+sb;
  1173.                end;
  1174.             end;
  1175.      8..15 : begin
  1176.                s := va(colorf[f-8]);
  1177.                case current_foreground of
  1178.                   0..7  : s := '1;'+s;
  1179.               {   8..15 : s := s; }
  1180.                  16..31 : s := '0;1;'+s+sb;
  1181.                end;
  1182.              end;
  1183.     16..23 : begin
  1184.                s := va(colorf[f-16]);
  1185.                case current_foreground of
  1186.                   0..7  : s := '5;'+s;
  1187.                   8..15,
  1188.                { 16..23 : s := s; }
  1189.                  24..31 : s := '0;5;'+s+sb;
  1190.                end;
  1191.             end;
  1192.     24..31 : begin
  1193.                s := va(colorf[f-24]);
  1194.                 case current_foreground of
  1195.                   0..7  : s := '1;5;'+s;
  1196.                   8..15 : s := '5;'+s;
  1197.                  16..23 : s := '1;'+s;
  1198.               {  24..31 : s := s; }
  1199.                 end;
  1200.             end;
  1201.      end;
  1202.        sendtext(#27+'['+s+'m');
  1203.     end;
  1204.   end;
  1205.   current_foreground:=f;
  1206. end;
  1207.  
  1208. procedure set_background;  { b : byte }
  1209. const
  1210.  colorb: array[0..7] of integer = (40,44,42,46,41,45,43,47);
  1211. begin;
  1212.  if b > 7 then exit;
  1213.  if (b = current_background) then exit;
  1214.  if Not NoLocal then textbackground(b);
  1215.  current_background:=b;
  1216.  if not local then
  1217.     if (current_foreground=7) and (b=0) then
  1218.        sendtext(#27+'[0m')
  1219.     else
  1220.        sendtext(#27+'['+va(colorb[b])+'m');
  1221. end;
  1222.  
  1223. Procedure Set_Color;     { f,b : byte }
  1224. const
  1225.   colorf: array[0..7] of integer = (30,34,32,36,31,35,33,37);
  1226.   colorb: array[0..7] of integer = (40,44,42,46,41,45,43,47);
  1227. var
  1228.  f1:byte;
  1229.  s:string;
  1230.  NoBackG_Ok : boolean;
  1231. begin
  1232.  if (f>31) or (b>7) then exit;
  1233.  if (f=current_foreground) and (b=current_background) then exit;
  1234.  if (f<>current_foreground) and (b<>current_background) then
  1235.     begin
  1236.       if Not NoLocal then
  1237.         begin
  1238.           textcolor(f);
  1239.           textbackground(b);
  1240.         end;
  1241.       If not local then
  1242.          If (f=7) and (b=0) then
  1243.             sendtext(#27+'[0m')
  1244.          else
  1245.          begin
  1246.           s := '[';
  1247.           NoBackG_OK := false;
  1248.           case f of
  1249.             0..7  : begin
  1250.                       f1:=f;
  1251.                       case current_foreground of
  1252.                       { 0..7  : s := s;  }
  1253.                         8..31 : begin
  1254.                                   s := s+'0;';
  1255.                                   NoBackG_OK := true;
  1256.                                 end;
  1257.                       end;
  1258.                     end;
  1259.             8..15 : begin
  1260.                       f1:=f-8;
  1261.                       case current_foreground of
  1262.                         0..7  : s := s+'1;';
  1263.                     {   8..15 : s := s; }
  1264.                        16..31 : begin
  1265.                                   s := s+'0;1;';
  1266.                                   NoBackG_OK := true;
  1267.                                 end;
  1268.                       end;
  1269.                     end;
  1270.            16..23 : begin
  1271.                       f1:=f-16;
  1272.                       case current_foreground of
  1273.                         0..7  : s := s+'5;';
  1274.                         8..15,
  1275.                      { 16..23 : s := s; }
  1276.                        24..31 : begin
  1277.                                   s := s+'0;5;';
  1278.                                   NoBackG_OK := true;
  1279.                                 end;
  1280.                      end;
  1281.                    end;
  1282.           24..31 : begin
  1283.                      f1:=f-24;
  1284.                      case current_foreground of
  1285.                         0..7  : s := s+'1;5;';
  1286.                         8..15 : s := s+'5;';
  1287.                        16..23 : s := s+'1;';
  1288.                     {  24..31 : s := s; }
  1289.                      end;
  1290.                    end;
  1291.          end;
  1292.          If NoBackG_OK and (b=0) then
  1293.            sendtext(#27+s+va(colorf[f1])+'m')
  1294.          else
  1295.            sendtext(#27+s+va(colorf[f1])+';'+va(colorb[b])+'m');
  1296.       end;
  1297.       current_foreground:=f;
  1298.       current_background:=b;
  1299.     end
  1300.      else
  1301.      if (f<>current_foreground) then
  1302.         set_foreground(f)
  1303.      else
  1304.        set_background(b);
  1305. end;
  1306.  
  1307. procedure prompt;
  1308. const
  1309.  promptcol1=7;
  1310.  promptcol2=1;
  1311.  promptcol3=15;
  1312. var
  1313.  fg,bg: integer;
  1314.  x,y,code: integer;
  1315.  ch: char;
  1316.  a: integer;
  1317.  hexsave: boolean;
  1318. begin;
  1319.  hexsave:=hexon;
  1320.  hexon:=false;
  1321.  fg:=current_foreground;
  1322.  bg:=current_background;
  1323.  get_stacked(s);
  1324.  if s<>'' then begin;
  1325.   set_foreground(promptcol3);
  1326.   while length(s)>le do delete(s,length(s),1);
  1327.   swrite(s);
  1328.   set_foreground(fg);
  1329.  end else begin;
  1330.   if not color_chg then pc:=false;
  1331.   if pc then begin;
  1332.    set_foreground(promptcol1);
  1333.    set_background(promptcol2);
  1334.    for a:=1 to le do swrite(' ');
  1335.    for a:=1 to le do swrite(#8);
  1336.    x:=wherex;
  1337.    y:=wherey;
  1338.   end;
  1339.   s:='';
  1340.   repeat;
  1341.    sread_char_filtered(ch);                                 { read(kbd,ch);}
  1342.    if (ch<>#8) and (ch<>^M) and (length(s)<le) then begin;
  1343.     s:=s+ch;
  1344.     swrite(ch);                                    { write(ch);}
  1345.    end;
  1346.    if length(s)>200 then delete(s,1,1);
  1347.    if (ch=chr(8)) and (length(s)>0) then begin;
  1348.     delete(s,length(s),1);
  1349.     swrite(chr(8));                                { write(#8,' ',#8);}
  1350.     swrite(' ');
  1351.     swrite(#8);
  1352.    end;
  1353.   until (ch=^M) or (length(s)=999);
  1354.   if pc then begin;
  1355.    set_foreground(promptcol3);
  1356.    set_background(bg);
  1357.    while wherex>x do swrite(#8);
  1358.    swrite(s);                                      { write(s);}
  1359.    while wherex<x+le do swrite(' ');               { write(' ');}
  1360.    set_foreground(fg);
  1361.   end;
  1362.   swriteln('');                                    { writeln('');}
  1363.   if pos(';',s)<>0 then begin;
  1364.    stacked:=s;
  1365.    get_stacked(s);
  1366.    while length(s)>le do delete(s,length(s),1);
  1367.   end;
  1368.  end;
  1369.  hexon:=hexsave;
  1370. end;
  1371.  
  1372. procedure sgoto_xy;
  1373. var
  1374.  s,s2: string;
  1375. begin;
  1376.  gotoxy(x,y);
  1377.  curlinenum := y;
  1378.  s:=#27+'[';
  1379.  str(y,s2);
  1380.  s:=s+s2;
  1381.  str(x,s2);
  1382.  s:=s+';'+s2+'f';
  1383.  if not local then sendtext(s);
  1384. end;
  1385.  
  1386. function skeypressed: boolean;
  1387. var
  1388.  b: boolean;
  1389. begin;
  1390.  b:=false;
  1391.  if not local then b:=AsyncCharPresent;
  1392.  if not b then b:=keypressed;
  1393.  if macro<>'' then b:=true;
  1394.  skeypressed:=b;
  1395. end;
  1396.  
  1397. procedure close_async_port;
  1398. begin;
  1399.  if buffered then begin;
  1400.    buffered:=false;
  1401.    AsyncFlushOutput;
  1402.    AsyncCloseUp;
  1403.  end;
  1404. end;
  1405.  
  1406. procedure open_async_port;
  1407. begin;
  1408.  AsyncSelectPort(com_port);
  1409.  if lockbaud=0 then
  1410.   AsyncSetBaud(baud_rate)
  1411.  else
  1412.   AsyncSetBaud(lockbaud);
  1413.  buffered := true;   { Not set in original DD - this may not be the best }
  1414.                      { place for this but it does work in my tests       }
  1415. end;
  1416. {
  1417.   }
  1418. var
  1419.  nclastchar: char;
  1420.  
  1421. function NewCrtOutPut(var f: textrec): integer;
  1422. var
  1423.  p: integer;
  1424. begin;
  1425.  for p:=0 to f.bufpos-1 do swrite(f.bufptr^[p]);
  1426.  f.bufpos:=0;
  1427.  NewCrtOutPut:=0;
  1428. end;
  1429.  
  1430. function NewCrtInPut(var f: textrec): integer;
  1431. var
  1432.  p: integer;
  1433.  ch: char;
  1434. begin;
  1435.  with f do begin;
  1436.   p:=0;
  1437.   if nclastchar=#13 then begin; nclastchar:=' '; end else repeat;
  1438.    ch:=readkey;
  1439.    nclastchar:=ch;
  1440.    write(ch);
  1441.    bufptr^[p]:=ch;
  1442.    inc(p);
  1443.    if ch=#13 then write(#10);
  1444.    if ch=#8 then begin;
  1445.     write(' '#8);
  1446.     if p>0 then dec(p);
  1447.     if p>0 then dec(p);
  1448.    end;
  1449.   until (p=bufsize-1) or (ch=#13);
  1450.   bufpos:=0;
  1451.   bufend:=p;
  1452.  end;
  1453.  NewCrtInput:=0;
  1454. end;
  1455.  
  1456. function NewCrtIgnore(var f: textrec): integer;
  1457. begin;
  1458.  newcrtignore:=0;
  1459. end;
  1460.  
  1461. function NewCRTOpen(var f: textrec): integer;
  1462. begin;
  1463.  if f.mode=fmInput then begin;
  1464.   f.inoutfunc:=@NewCrtInput;
  1465.   f.flushfunc:=@NewCrtIgnore;
  1466.  end else begin;
  1467.   f.mode:=fmOutput;
  1468.   f.inoutfunc:=@NewCrtOutPut;
  1469.   f.flushfunc:=@NewCrtOutPut;
  1470.  end;
  1471.  NewCrtOpen:=0;
  1472. end;
  1473.  
  1474. Function RipDetect: boolean;
  1475. var
  1476.   i,j,k : integer;
  1477.   a : char;
  1478.   s : string;
  1479.   RipYes : boolean;
  1480. begin
  1481.  RipYes := false;
  1482.  If local then
  1483.    begin
  1484.      RipDetect := RipYes;
  1485.      exit;
  1486.    end;
  1487.  
  1488.  sendtext(#27+'[0;30m'+#13+#10);
  1489.  writeln;
  1490.  writeln('Checking for RIP');
  1491.  sendtext(#27'[!');
  1492.  delay(222);
  1493.  s := '';
  1494.  i := 0;
  1495.  j := 0;
  1496.  charorigin:=localchar;
  1497.  repeat;
  1498.  
  1499.    a:=chr(0);
  1500.    inc(i);
  1501.  
  1502.   If (Not AsyncCarrierPresent) then DropMessage;
  1503.  
  1504.   if charin(a) then
  1505.     charorigin:=remotechar;
  1506.   if (a<>chr(0)) then
  1507.     begin
  1508.       s := s+a;
  1509.       inc(j);
  1510.     end
  1511.   else
  1512.      begin
  1513.        If (i mod 50 = 0) then
  1514.          ReleaseTimeSlice;
  1515.      end;
  1516.   delay(2);
  1517.   until (i>666) or (j>13);
  1518.  
  1519.   If Copy(s,1,3) = 'RIP' then
  1520.     begin
  1521.       RipYes := true;
  1522.       writeln('Rip Detected');
  1523.       if charin(a) then
  1524.          charorigin:=remotechar;
  1525.     end;
  1526.  RipDetect := RipYes;
  1527.  Swriteln('');
  1528. end;
  1529.  
  1530. procedure DDAssignSOutput(var f: text);
  1531. begin;
  1532.  with textrec(f) do begin;
  1533.   handle   := $FFFF;
  1534.   mode     := fmclosed;
  1535.   bufsize  := sizeof(buffer);
  1536.   bufptr   := @buffer;
  1537.   OpenFunc := @NewCrtOpen;
  1538.   CloseFunc:= @NewCrtIgnore;
  1539.   Name[0]  := #0;
  1540.  end;
  1541. end;
  1542.  
  1543. Procedure StatusMess(var fs:string);
  1544. begin
  1545.   Set_Color(2,0);
  1546.   Case Tasker of
  1547.     1 : writeln('DESQview Detected');
  1548.     2 : writeln('Windows 3.xx Detected');
  1549.     3 : writeln('OS/2 Detected');
  1550.     4 : writeln('Win/NT Detected');
  1551.     5 : writeln('Dos 5.0 with Network Detected');
  1552.     6 : writeln('Dos 5.0+ Detected');
  1553.   else
  1554.         writeln('No Multiplexer Detected');
  1555.   end;
  1556.   If FossilIO or DigiIO then
  1557.    begin
  1558.       Set_Foreground(10);
  1559.       writeln(fs);
  1560.    end;
  1561.   Set_Color(7,0);
  1562.   ReleaseTimeSlice;
  1563. end;
  1564.  
  1565. procedure InitDoorDriver(ConfigFileName: string);
  1566. Var
  1567.  i,a: byte;
  1568.  b: integer;
  1569.  junk: word;
  1570.  fossilstr:string;
  1571. begin;
  1572.  initddansi;
  1573.  oldtextmode:=lastmode;
  1574.  lastsetfore:=99;
  1575.  setforecheck:=false;
  1576.  badchar:='';
  1577.  fossilstr:='';
  1578.  digiio:=false;
  1579.  fossilio:=false;
  1580.  ansion:=false;
  1581.  moreok:=false;
  1582.  numlines:=25;
  1583.  cc:=0;
  1584.  F1toggle:=0;
  1585.  Inchat:=0;
  1586.  clrscr;
  1587.  window(1,1,80,numlines-1);
  1588.  node_num:=1;
  1589.  statfore:=7;
  1590.  statback:=1;
  1591.  GoRip := 0;
  1592.  com_port:=0;
  1593.  fouled_up:=#0;
  1594.  stacked:='';
  1595.  hexon:=false;
  1596.  buffered:=false;
  1597.  cdropped:=false;
  1598.  tdropped:=false;
  1599.  exitsave:=exitproc;
  1600.  exitproc:=@DDexit;
  1601.  firsttime:=true;
  1602.  
  1603.  LoadPorts(port1,port2,port3,port4,irq1,irq2,irq3,irq4);
  1604.  Loadconfig( ConfigFileName,
  1605.              bbs_software,
  1606.              user_first_name,user_last_name,
  1607.              user_access_level,
  1608.              bbs_time_left,
  1609.              com_port,
  1610.              baud_rate,
  1611.              node_num,
  1612.              local,
  1613.              graphics,
  1614.              color1,
  1615.              color_chg,
  1616.              noFossinit,
  1617.              board_name,
  1618.              pause_code,
  1619.              sysop_first_name,
  1620.              sysop_last_name,
  1621.              maxtime,
  1622.              localcol,
  1623.              statfore,
  1624.              statback,
  1625.              statline,
  1626.              EMSOK,NetOK,
  1627.              nolocal,
  1628.              fossilio,
  1629.              digiio,
  1630.              dropfilepath,
  1631.              GoRip,
  1632.              lockbaud,
  1633.              nodirect,
  1634.              port1,port2,port3,port4,irq1,irq2,irq3,irq4);
  1635.  
  1636.  numlines:=25;
  1637.  if nodirect then directvideo:=false;
  1638.  clrscr;
  1639.  window(1,1,80,numlines-1);
  1640.  textcolor(7);
  1641.  textbackground(0);
  1642.  default_fore:=7;
  1643.  default_back:=0;
  1644.  gettime(st_hr,st_mn,st_sc,junk);
  1645.  
  1646.  GetBBSInfo( bbs_software,
  1647.              user_first_name,user_last_name,
  1648.              user_access_level,
  1649.              bbs_time_left,
  1650.              com_port,
  1651.              baud_rate,
  1652.              node_num,
  1653.              local,
  1654.              graphics,
  1655.              color1,
  1656.              color_chg,
  1657.              board_name,
  1658.              sysop_first_name,
  1659.              sysop_last_name,
  1660.              maxtime,
  1661.              dropfilepath,
  1662.              lockbaud);
  1663.  
  1664.  ReSetPorts(port1,port2,port3,port4,irq1,irq2,irq3,irq4);
  1665.  
  1666.  if not local then
  1667.    begin;
  1668.     if FossilIO then AsyncSelectFossil(fossilstr) else
  1669.      if DigiIO then AsyncSelectDigiBoard(fossilstr) else
  1670.       AsyncSelectInternal;
  1671.     Open_Async_Port;
  1672.    end;
  1673.  
  1674.  if not local then
  1675.   if not initok then
  1676.    begin
  1677.      writeln('');
  1678.      if fossilio then
  1679.       begin
  1680.         writeln('Fossil was not initialized properly! You should change to INTERNAL');
  1681.         writeln('communications routines.');
  1682.       end
  1683.     else
  1684.     if digiio then
  1685.       begin
  1686.         writeln('DigiDriver was not initialized properly!');
  1687.       end;
  1688.     delay(3000);
  1689.     halt;
  1690.   end;
  1691.  
  1692.  If GoRip = 4 then     { forces RipLink on }
  1693.    If Local then       { If local then forces it into graphics mode as well}
  1694.      graphics := 5;
  1695.  If Graphics <> 5 then
  1696.     If RipDetect then
  1697.           graphics := 5;
  1698.  
  1699.  DV_Aware_ON;
  1700.  current_foreground:=default_fore;
  1701.  current_background:=default_back;
  1702.  if graphics = 3 then
  1703.    begin
  1704.      set_foreground(statfore);
  1705.      set_background(statback);
  1706.    end;
  1707.  curlinenum:=1;
  1708.  time_check:=true;
  1709.  time_credit:=0;
  1710.  macro_str:='';
  1711.  macro:='';
  1712.  mintime:=1;
  1713.  notime:='';
  1714.  user_first_name:=stu(user_first_name);
  1715.  user_last_name:=stu(user_last_name);
  1716.  stackon:=true;
  1717. { if node_num=0 then node_num:=1; }
  1718.  ddassignsoutput(soutput);
  1719.  rewrite(soutput);
  1720.  If Not NetOk then
  1721.    If (Tasker = 5) then inc(Tasker);
  1722.  StatusMess(fossilstr);
  1723.  
  1724. end;
  1725.  
  1726. end.
  1727.  
  1728.